Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/ISSUE17/CGI/CGIAPI.PAS

Pascal/Delphi Source File | 1996-10-29 | 7.7 KB | 293 lines

unit CGIAPI;

interface

uses
  Classes, INIFIles;

type
  TEnvironmentType = (etStdCGI, etWinCGI);

  TCGI = class
  private
    FCGIItems: TStringList;
    FFormItems: TStringList;
    FEnvironmentType: TEnvironmentType;
    FOutputFile: TextFile;
    FWinCGIProfileName: string;
    FWinCGIProfile: TINIFile;
  protected
    constructor Create; virtual;
    destructor Destroy; override;
    procedure LoadStdCGIUserData;
    procedure LoadWinCGIUserData;
    procedure UnpackURLString( S: PChar ); virtual;
  public
    procedure DumpWinCGIProfile;
    function GetEnv(Variable: string): string;
    procedure Write(Value: string);
    procedure WriteLn(Value: string);
    property CGIItems: TStringList read FCGIItems;
    property EnvironmentType: TEnvironmentType read FEnvironmentType;
    property FormItems: TStringList read FFormItems;
    property OutputFile: TextFile read FOutputFile write FOutputFile;
    property WinCGIProfile: TINIFile read FWinCGIProfile;
  end;

var
  CGI: TCGI;

implementation

uses
  SysUtils, Windows;

const
  NumCGIVars = 15;

  { These are the standard names used by the calling application
    to reference CGI variables.  They generally follow the
    WinCGI names. }
  CGIVarNames: array[0..NumCGIVars - 1] of string[31] =
    ('SERVER SOFTWARE',
     'SERVER NAME',
     'SERVER PORT',
     'CGI VERSION',
     'REQUEST PROTOCOL',
     'REQUEST METHOD',
     'LOGICAL PATH',
     'PHYSICAL PATH',
     'EXECUTABLE PATH',
     'QUERY STRING',
     'REMOTE HOST',
     'REMOTE ADDRESS',
     'REMOTE USER',
     'CONTENT LENGTH',
     'CONTENT TYPE');

  { These are the actual variable names used by each protocol. }
  CGIVars: array[0..NumCGIVars - 1, TEnvironmentType] of string[31] =
     { etStdCGI              etWinCGI }
    (
     ('SERVER_SOFTWARE',    'SERVER SOFTWARE'),
     ('SERVER_NAME',        'SERVER NAME'),
     ('SERVER_PORT',        'SERVER PORT'),
     ('GATEWAY_INTERFACE',  'CGI VERSION'),
     ('SERVER_PROTOCOL',    'REQUEST PROTOCOL'),
     ('REQUEST_METHOD',     'REQUEST METHOD'),
     ('PATH_INFO',          'LOGICAL PATH'),
     ('PATH_TRANSLATED',    'PHYSICAL PATH'),
     ('SCRIPT_NAME',        'EXECUTABLE PATH'),
     ('QUERY_STRING',       'QUERY STRING'),
     ('REMOTE_HOST',        'REMOTE HOST'),
     ('REMOTE_ADDR',        'REMOTE ADDRESS'),
     ('REMOTE_USER',        'REMOTE USER'),
     ('CONTENT_LENGTH',     'CONTENT LENGTH'),
     ('CONTENT_TYPE',       'CONTENT TYPE')
     );

constructor TCGI.Create;
var
  I: Integer;
begin
  inherited Create;

  FCGIItems := TStringList.Create;
  FFormItems := TStringList.Create;

  { Detect whether we are standard CGI or WinCGI. }
  if GetEnv('SERVER_NAME') <> '' then
    FEnvironmentType := etStdCGI
  else
  begin
    FEnvironmentType := etWinCGI;
    FWinCGIProfileName := ParamStr(1);
    FWinCGIProfile := TINIFile.Create(FWinCGIProfileName);
  end;

  { Assign and open our output file accordingly. }
  case EnvironmentType of
    etStdCGI: AssignFile(OutputFile, '');
    etWinCGI: AssignFile(OutputFile, WinCGIProfile.ReadString('System', 'Output File', ''));
  end;
  Rewrite(OutputFile);

  { Write standard HTML header for the output page. }
  WriteLn('Content-type: text/html');
  WriteLn('');

  { Load CGI variables and user's form variables. }
  case EnvironmentType of
    etStdCGI: begin
                for I := 0 to NumCGIVars - 1 do
                  FCGIItems.Values[CGIVarNames[I]] :=
                    GetEnv(CGIVars[I, etStdCGI]);

                LoadStdCGIUserData;
              end;
    etWinCGI: begin
                for I := 0 to NumCGIVars - 1 do
                  FCGIItems.Values[CGIVarNames[I]] :=
                    WinCGIProfile.ReadString('CGI', CGIVars[I, etWinCGI], '');

                LoadWinCGIUserData;
              end;
  end;
end;

destructor TCGI.Destroy;
begin
  CloseFile(OutputFile);

  FCGIItems.Free;
  FFormItems.Free;
  FWinCGIProfile.Free;
end;

procedure TCGI.DumpWinCGIProfile;
{ Writes the contents of the WinCGI profile file to the
  response page. }
var
  FCB: TextFile;
  Rec: string;
begin
  if FWinCGIProfile <> nil then
  begin
    AssignFile(FCB, FWinCGIProfileName);
    Reset(FCB);
    try
      while not Eof(FCB) do
      begin
        ReadLn(FCB, Rec);
        WriteLn(Rec + '<BR>');
      end;
    finally
      CloseFile(FCB);
    end;
  end;
end;

function TCGI.GetEnv(Variable: string): string;
{ Returns the value iof the given environment variable. }
var
  EnvVariable: array[0..127] of char;
  EnvBuffer: array[0..1023] of char;
begin
  StrPCopy(EnvVariable, Variable);
  Result := '';
  if GetEnvironmentVariable(PChar(Variable), @EnvBuffer, SizeOf(EnvBuffer)) <> 0 then
    Result := StrPas(EnvBuffer);
end;

procedure TCGI.LoadStdCGIUserData;
{ Reads, parses, and decodes values for the standard CGI form variables. }
var
  ContentLength: LongInt;
  InputFCB: File;
  InputBuffer: PChar;
  RequestMethod: string;
  UserContentBuffer: string;
begin
  RequestMethod := Uppercase(FCGIItems.Values['REQUEST METHOD']);

  { If the form action is a POST, then we get form variables from
    the standard input device. }
  if RequestMethod = 'POST' then
  begin
    if FCGIItems.Values['CONTENT TYPE'] <> '' then
    begin
      ContentLength := StrToInt(FCGIItems.Values['CONTENT LENGTH']);
      AssignFile(InputFCB, '');  { standard input }
      Reset(InputFCB, 1);
      try
        InputBuffer := StrAlloc(ContentLength + 1);
        FillChar(InputBuffer^, ContentLength + 1, #0);
        try
          BlockRead(InputFCB, InputBuffer^, ContentLength);
          UnpackURLString(InputBuffer);
        finally
          StrDispose(InputBuffer);
        end;
      finally
        CloseFile(InputFCB);
      end;
    end;
  end

  { If the form action is GET, then we get form variables from
    from the QUERY STRING variable. }
  else if RequestMethod = 'GET' then
  begin
    UserContentBuffer := FCGIItems.Values['QUERY STRING'];
    InputBuffer := StrAlloc(Length(UserContentBuffer));
    try
      StrPCopy(InputBuffer, UserContentBuffer);
      UnpackURLString(InputBuffer);
    finally
      StrDispose(InputBuffer);
    end;
  end;
end;

procedure TCGI.LoadWinCGIUserData;
{ Copies values for WinCGI form variables. }
begin
  { All form variables are found in the [Form Literal] section of
    the profile file. }
  WinCGIProfile.ReadSectionValues('Form Literal', TStrings(FFormItems));
end;

procedure TCGI.UnpackURLString( S: PChar );
{ Parses and decodes a URL-encoded string.  Copies variable values into
  the FFormItems field. }
var
  LabelStr: ShortString;
  ValueStr: ShortString;
begin
  LabelStr := '';
  ValueStr := '';
  while S^ <> #0 do
  begin
    case S^ of
      '+' : ValueStr := ValueStr + ' ';
      '%' : begin
              ValueStr := ValueStr + Chr(StrToInt('$' + (S + 1)^ + (S + 2)^));
              Inc(S, 2);
            end;
      '=' : if LabelStr = '' then
            begin
              LabelStr := ValueStr;
              ValueStr := '';
            end;
      '&' : begin
              FFormItems.Values[LabelStr] := ValueStr;
              ValueStr := '';
              LabelStr := '';
            end;
      else ValueStr := ValueStr + S^;
    end;
    Inc(S);
  end;

  if ValueStr <> '' then
    FFormItems.Values[LabelStr] := ValueStr;
end;

procedure TCGI.Write(Value: AnsiString);
{ Standard Write to the output page. }
begin
  System.Write(OutputFile, Value);
end;

procedure TCGI.WriteLn(Value: AnsiString);
{ Standard WriteLn to the output page. }
begin
  System.WriteLn(OutputFile, Value);
end;

initialization
  CGI := TCGI.Create;
finalization
  CGI.Free;
end.